home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG: World of Games / PC-SIG World of Games (CDRM1080710) (1993).iso / 262 / ACOURSE.ASC next >
Text File  |  1984-02-18  |  13KB  |  278 lines
  1. 10000 '*************************************************************
  2. 10010 '*****    PC-GOLF    THE GOLFER's PROGRAM     PC-GOLF    *****
  3. 10020 '*****    Version 1.3  (C) 1982,1983,1984 Ed Chandler    *****
  4. 10030 '*************************************************************
  5. 10040 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  6. 10050 '     4.0. GET THE GOLF COURSE LIST
  7. 10060 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  8. 10070 CLS:PRINT MNU4$:PRINT
  9. 10072 IF ROS=0 THEN 10080
  10. 10075 DEF SEG=&H40:I%=PEEK(&H17):I%=I% OR 32:POKE &H17,I% 'num lock on
  11. 10080 MNU1$="1.  REVIEW the list of courses.":PRINT SPC(3);MNU1$
  12. 10090 MNU2$="2.  ADD a new course to the list.":PRINT SPC(3);MNU2$
  13. 10100 MNU3$="3.  CHANGE a course in the list.":PRINT SPC(3);MNU3$
  14. 10110 MNU5$="4.  DELETE a course from the list.":PRINT SPC(3);MNU5$
  15. 10120 PRINT  SPC(3);MNURT$:PRINT
  16. 10130 M1$="key":M2$="(1,2,3,4 or M). ":GOSUB 570
  17. 10140 IF KB$="1" THEN 10230 'review
  18. 10150 IF KB$="2" THEN 11570 'add
  19. 10160 IF KB$="3" THEN 10300 'update
  20. 10170 IF KB$="4" THEN 11280 'delete
  21. 10180 IF KB$="M" OR KB$="m" THEN 530 'back to main
  22. 10190 GOSUB 610:GOTO 10070
  23. 10200 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  24. 10210 '     4.1.   REVIEW COURSE DESCRIPTION
  25. 10220 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  26. 10230 GOSUB 10240:GOTO 10070
  27. 10240 CLS:PRINT MNU1$:M1=1:GOSUB 540 'show courses
  28. 10250 IF CD=0 THEN GOSUB 580
  29. 10260 RETURN
  30. 10270 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  31. 10280 '     4.3.   UPDATE COURSE DESCRIPTION
  32. 10290 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  33. 10300 GOSUB 10310:GOTO 10070
  34. 10310 CLS:PRINT MNU3$
  35. 10320 RESTORE 816:GOSUB 600
  36. 10330 IF KB$<>"Y" THEN RETURN
  37. 10340 CLS:PRINT MNU3$:M1=0:GOSUB 540 'show courses
  38. 10350 IF CD=0 THEN GOSUB 580:RETURN
  39. 10360 PRINT:M1$="PRESS the line number of the course you want to update. "
  40. 10370 GOSUB 560:IF KB>0 AND KB<=CMAX AND TMP(KB)=KB THEN RN=KB:GOTO 10390
  41. 10380 PRINT:PRINT"You must choose a number from the list.":GOSUB 580:GOTO 10340
  42. 10390 RESTORE 821:GOSUB 600
  43. 10400 IF KB$<>"Y" THEN 10310
  44. 10410 '+++++      change a field     +++++
  45. 10420 GOSUB 650:GOSUB 655:GET #2,RN:GET #3,RN 'get record to be changed
  46. 10430 CLS:PRINT MNU3$: PRINT:PRINT "LINE #"
  47. 10440 PRINT " 1. Course Name  ";SPC(5);B2$
  48. 10450 PRINT " 2. Telephone    ";SPC(5);C2$
  49. 10460 PRINT " 3. Pro's  Name  ";SPC(5);D2$
  50. 10470 PRINT " 4. Par scores   ";SPC(5);". . ."
  51. 10480 PRINT " 5. Course Rating";SPC(5);". . ."
  52. 10490 PRINT " 6. Hole handicaps";SPC(4);". . ."
  53. 10500 PRINT:M1$="PRESS the number of the line you want to change. "
  54. 10510 GOSUB 560:IF KB>0 AND KB<=6 THEN 10540
  55. 10520 PRINT:PRINT "Please choose a line number from the list."
  56. 10530 GOSUB 580:GOTO 10430
  57. 10540 RESTORE 814:GOSUB 600
  58. 10550 IF KB$<>"Y" THEN 10430
  59. 10560 '+++++     name     +++++
  60. 10570 IF KB<>1 THEN 10660
  61. 10580 LNBR=CSRLIN:CNBR=POS(0)
  62. 10590 KB$=INKEY$:IF KB$<>"" THEN 10590
  63. 10600 LOCATE LNBR,CNBR:PRINT:LINE INPUT"ENTER the replacement name. ";KB$
  64. 10610 IF LEN(KB$)>0 AND LEN(KB$)<=NMAX THEN GOSUB 700:LSET B2$=KB$:GOTO 11230
  65. 10620 LOCATE LNBR+3,CNBR:PRINT"The name is too long. ";NMAX;" letters maximum. Try again."
  66. 10630 GOSUB 580:LOCATE LNBR,CNBR:FOR I=1 TO 7:PRINT SPACE$(80);:NEXT
  67. 10640 GOTO 10590
  68. 10650 '+++++     phone #     +++++
  69. 10660 IF KB<>2 THEN 10740
  70. 10670 LNBR=CSRLIN:CNBR=POS(0)
  71. 10680 KB$=INKEY$:IF KB$<>"" THEN 10680
  72. 10690 LOCATE LNBR,CNBR:PRINT:LINE INPUT"ENTER the replacement phone number. ";KB$
  73. 10700 L=LEN(KB$):IF L=8 THEN RSET C2$=KB$:GOTO 11230
  74. 10710 LOCATE LNBR+3,CNBR:PRINT"Please limit the phone number to 8 characters."
  75. 10720 GOSUB 580:LOCATE LNBR,CNBR:FOR I=1 TO 7:PRINT SPACE$(80);:NEXT:GOTO 10680
  76. 10730 '+++++     name     +++++
  77. 10740 IF KB<>3 THEN 10830
  78. 10750 LNBR=CSRLIN:CNBR=POS(0)
  79. 10760 KB$=INKEY$:IF KB$<>"" THEN 10760
  80. 10770 LOCATE LNBR,CNBR:PRINT:LINE INPUT"ENTER the replacement name. ";KB$
  81. 10780 IF LEN(KB$)>0 AND LEN(KB$)<=NMAX THEN GOSUB 700:LSET D2$=KB$:GOTO 11230
  82. 10790 LOCATE LNBR+3,CNBR:PRINT"The name is too long. ";NMAX;" letters maximum. Try again."
  83. 10800 GOSUB 580:LOCATE LNBR,CNBR:FOR I=1 TO 7:PRINT SPACE$(80);:NEXT
  84. 10810 GOTO 10770
  85. 10820 '+++++     par's     +++++
  86. 10830 IF KB<>4 THEN 10960
  87. 10840 T1=1:T$="MEN's":P$=E2$:RESTORE 827:GOSUB 600:IF KB$="Y" THEN 10860
  88. 10850 T1=0:T$="LADIES":P$=H2$:RESTORE 828:GOSUB 600:IF KB$<>"Y" THEN 11230
  89. 10860 N=1:M=18:GOSUB 730 'p$ to ps(i)
  90. 10870 T$=T$+" PAR's":M1$="Par"
  91. 10880 S=1:N=1:M=9:L=0:RESTORE 825:GOSUB 600
  92. 10890 IF KB$="Y" THEN GOSUB 740:GOTO 10880 'make a change
  93. 10900 S=1:N=1:M=9:L=9:RESTORE 826:GOSUB 600
  94. 10910 IF KB$="Y" THEN GOSUB 740:GOTO 10900 'make a change
  95. 10920 N=1:M=18:N$="":GOSUB 680 'convert PS(i) to P$
  96. 10930 IF T1=1 THEN LSET E2$=P$ ELSE LSET H2$=P$ 'changes made
  97. 10940 GOTO 11230
  98. 10950 '+++++     rating     +++++
  99. 10960 IF KB<>5 THEN 11110
  100. 10970 CLS:PRINT MNU3$:PRINT:PRINT SPC(3)"COURSE RATING"
  101. 10980 PRINT USING"1. GOLD     ##.#";CVS(K2$)
  102. 10990 PRINT USING"2. BLUE     ##.#";CVS(L2$)
  103. 11000 PRINT USING"3. WHITE    ##.#";CVS(F2$)
  104. 11010 PRINT USING"4. RED      ##.#";CVS(I2$):PRINT
  105. 11020 M1$="PRESS the line number of your choice.(1,2,3 or 4). ":GOSUB 560
  106. 11030 IF KB<1 OR KB>4 THEN GOSUB 610:GOTO 10970
  107. 11040 T1=KB:GOSUB 12400 'get new rating
  108. 11050 IF T1=1 THEN RSET K2$=MKS$(T!)
  109. 11060 IF T1=2 THEN RSET L2$=MKS$(T!)
  110. 11070 IF T1=3 THEN RSET F2$=MKS$(T!)
  111. 11080 IF T1=4 THEN RSET I2$=MKS$(T!)
  112. 11090 GOTO 11230
  113. 11100 '+++++     handicaps     +++++
  114. 11110 IF KB<>6 THEN 11230
  115. 11120 T1=1:T$="MEN's":P$=G2$:RESTORE 829:GOSUB 600:IF KB$="Y" THEN 11140
  116. 11130 T1=0:T$="LADIES":P$=J2$:RESTORE 830:GOSUB 600:IF KB$<>"Y" THEN 11230
  117. 11140 N=2:M=18:GOSUB 730 'p$ to ps(i)
  118. 11150 T$=T$+" HANDICAP's":M1$="H'cap"
  119. 11160 S=2:M=9:L=0:RESTORE 825:GOSUB 600
  120. 11170 IF KB$="Y" THEN GOSUB 740:GOTO 11160 'make a change
  121. 11180 S=2:M=9:L=9:RESTORE 826:GOSUB 600
  122. 11190 IF KB$="Y" THEN GOSUB 740:GOTO 11180 'make a change
  123. 11200 N=2:M=18:N$="":GOSUB 680 'convert PS(i) to P$
  124. 11210 IF T1=1 THEN LSET G2$=P$ ELSE LSET J2$=P$ 'changes made
  125. 11220 '+++++     update  GCDIR.DAT     +++++
  126. 11230 PUT #2,RN:PUT #3,RN:CLOSE #2,#3:CLS:PRINT "Update completed for ";B2$
  127. 11240 GCDIR$(RN)=A2B$:M1=0:GOSUB 540:GOSUB 590:RETURN
  128. 11250 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  129. 11260 '     4.4.  Delete a course from the directory
  130. 11270 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  131. 11280 GOSUB 11290:GOTO 10070
  132. 11290 CLS:PRINT MNU5$:M1=0:GOSUB 540 'show courses
  133. 11300 IF CD=0 THEN GOSUB 580:RETURN 'empty
  134. 11310 RESTORE 823:GOSUB 600:IF KB$<>"Y" THEN RETURN
  135. 11320 '
  136. 11330 PRINT:M1$="PRESS the line number of the course you want to delete. "
  137. 11340 GOSUB 560:IF KB>0 AND KB<=CMAX AND TMP(KB)=KB THEN RN=KB:GOTO 11370
  138. 11350 PRINT:PRINT"You must choose a number from the list.":GOSUB 580:GOTO 11290
  139. 11360 '+++++     test players home course
  140. 11370 J=0:T$=STR$(RN):GOSUB 660:GOSUB 641 'PDIR.DAT/TEMP.DAT
  141. 11380 FOR I=1 TO PACT:GET #4,I:IF E4$=T$ THEN J=J+1:LSET TA1$=B4$:PUT #1,J
  142. 11390 NEXT I:IF J=0 THEN 11460
  143. 11400 GOSUB 650:GET #2,RN:KB$=B2$:GOSUB 700:PRINT
  144. 11410 COLOR 0,15,0:PRINT "*** Warning *** ";:COLOR 7,0,0
  145. 11420 PRINT SPC(2)KB$;" is the home course for:":PRINT:BEEP
  146. 11430 FOR I=1 TO J:GET #1,I:PRINT TA1$;:IF FNNMODM(I,3)=0 THEN PRINT
  147. 11440 NEXT:PRINT
  148. 11450 '+++++
  149. 11460 CLOSE #1,#2,#4:RESTORE 824:GOSUB 600
  150. 11470 IF KB$<>"Y" THEN RETURN
  151. 11480 X=-1:GOSUB 640 ' reduce CACT count
  152. 11490 GOSUB 650:GOSUB 655:GET #2,RN:GET #3,RN:M1$=B2$:GOSUB 656 'init #2,#3
  153. 11500 PUT #2,RN:PUT #3,RN:CLOSE #2,#3 'write empty slots
  154. 11510 GCDIR$(RN)=A2$+B2$ 'remove course from gcdir$
  155. 11520 CLS:PRINT "Deletion completed for ";M1$
  156. 11530 M1=0:GOSUB 540:GOSUB 580:RETURN
  157. 11540 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  158. 11550 '     4.2.  Add a course to the directory
  159. 11560 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  160. 11570 GOSUB 11580:GOTO 10070
  161. 11580 CLS:PRINT MNU2$
  162. 11590 '+++++     Find empty slot for the addition     +++++
  163. 11600 FOR X=1 TO CMAX:N=CVI(LEFT$(GCDIR$(X),2)):IF N=0 THEN 11650
  164. 11610 NEXT
  165. 11620 PRINT:PRINT"The Course Directory is full.":PRINT
  166. 11630 PRINT"To add a course you must first"
  167. 11640 PRINT"delete a course from the list.":GOSUB 580:RETURN
  168. 11650 PRINT
  169. 11660 PRINT"You should have the course ratings and scorecard for the course."
  170. 11670 GOSUB 580
  171. 11680 '+++++     open #2,#3     +++++
  172. 11690 GOSUB 650:GOSUB 655:GCDIR$(X)=MKI$(X):RN=X:RSET A2$=MKI$(RN) 'record #
  173. 11700 '+++++     name     +++++
  174. 11710 KB$=INKEY$:IF KB$<>"" THEN 11710
  175. 11720 CLS:PRINT MNU2$:PRINT
  176. 11730 LINE INPUT"ENTER the name of the golf course you are adding. ";KB$
  177. 11740 L=LEN(KB$):IF L>0 AND L<=NMAX THEN 11770
  178. 11750 PRINT:PRINT"The name is too long. ";NMAX;" letters maximum.  Try again."
  179. 11760 GOSUB 580:GOTO 11710
  180. 11770 IF INSTR(KB$,"*")=0 THEN 11800
  181. 11780 PRINT:PRINT"Asterisks(*) are not allowed in the course name. Try again."
  182. 11790 GOSUB 580:GOTO 11710 'bad name
  183. 11800 GOSUB 700:LSET B2$=KB$ 'name
  184. 11810 '+++++     phone #     +++++
  185. 11820 KB$=INKEY$:IF KB$<>"" THEN 11820
  186. 11830 CLS:PRINT MNU2$:PRINT
  187. 11840 LINE INPUT"ENTER the pro shop phone number, e.g. 555-1212 . ";KB$
  188. 11850 L=LEN(KB$):IF L=8 THEN 11880
  189. 11860 PRINT:PRINT"Please limit the phone number to 8 characters."
  190. 11870 GOSUB 580:GOTO 11820
  191. 11880 RSET C2$=KB$ 'phone #
  192. 11890 '+++++     name     +++++
  193. 11900 KB$=INKEY$:IF KB$<>"" THEN 11900
  194. 11910 CLS:PRINT MNU2$:PRINT
  195. 11920 LINE INPUT "ENTER the name of the Golf Professional. ";KB$
  196. 11930 L=LEN(KB$):IF L>0 AND L<=NMAX THEN 11960
  197. 11940 PRINT:PRINT"Please limit the name to ";NMAX;" letters maximum."
  198. 11950 GOSUB 580:GOTO 11900
  199. 11960 GOSUB 700:LSET D2$=KB$ 'name
  200. 11970 '+++++     pars
  201. 11980 KB$=B2$:GOSUB 700
  202. 11990 CLS:PRINT MNU2$:PRINT
  203. 12000 PRINT"You should have the course ratings and scorecard for ";KB$;"."
  204. 12010 GOSUB 580:M1$="MENS":GOSUB 12250:LSET E2$=P$
  205. 12020 CLS:PRINT"Are the pars for Men and Ladies the same?"
  206. 12030 RESTORE 834:GOSUB 600:IF KB$="Y" THEN 12050
  207. 12040 GOSUB 580:M1$="LADIES":GOSUB 12250 'ladies
  208. 12050 LSET H2$=P$
  209. 12060 '+++++    handicap
  210. 12070 GOSUB 580:M1$="MENS":GOSUB 12540:LSET G2$=P$ 'men
  211. 12080 CLS:PRINT"Are the Handicaps for Men and Ladies the same?"
  212. 12090 RESTORE 834:GOSUB 600:IF KB$="Y" THEN 12110
  213. 12100 GOSUB 580:M1$="LADIES":GOSUB 12540 'ladies
  214. 12110 LSET J2$=P$
  215. 12120 '+++++     rating
  216. 12130 GOSUB 580:T1=1:GOSUB 12400:RSET K2$=MKS$(T!)'gold
  217. 12140 GOSUB 580:T1=2:GOSUB 12400:RSET L2$=MKS$(T!)'blue
  218. 12150 GOSUB 580:T1=3:GOSUB 12400:RSET F2$=MKS$(T!)'white
  219. 12160 GOSUB 580:T1=4:GOSUB 12400:RSET I2$=MKS$(T!)'red
  220. 12170 '+++++     create course record     +++++
  221. 12180 PUT #2,RN:PUT #3,RN:CLOSE #2,#3
  222. 12190 '+++++     Update CACT - INIT.DAT FILE     +++++
  223. 12200 X=1:GOSUB 640 'Update count of active courses
  224. 12210 GCDIR$(RN)=A2B$ 'save course description
  225. 12220 CLS:PRINT"Addition completed for ";B2$:M1=0:GOSUB 540:GOSUB 590:RETURN
  226. 12230 '+++++     subroutine to get pars for front and back nines     +++++
  227. 12240 '+++++     front side     +++++
  228. 12250 CLS:PRINT"ENTER the ";M1$;" pars for the FRONT side."
  229. 12260 PRINT:PRINT SPC(6);"Hole #  Par"
  230. 12270 S=1:N=1:M=9:L=0:GOSUB 720 'get pars
  231. 12280 PRINT:PRINT SPC(6);"Par is ";SUM
  232. 12290 RESTORE 833:GOSUB 600:T$="Change a front nine par"
  233. 12300 IF KB$="Y" THEN T1$=M1$:M1$="Par":GOSUB 740:M1$=T1$:GOTO 12290
  234. 12310 '+++++     back side     +++++
  235. 12320 CLS:PRINT"ENTER the ";M1$;" pars for the BACK side."
  236. 12330 PRINT:PRINT SPC(6);"Hole #  Par"
  237. 12340 S=1:N=1:M=9:L=9:GOSUB 720 'get pars
  238. 12350 PRINT:PRINT SPC(6);"Par is ";SUM:PRINT
  239. 12360 RESTORE 833:GOSUB 600:T$="Change a back nine par"
  240. 12370 IF KB$="Y" THEN T1$=M1$:M1$="Par":GOSUB 740:M1$=T1$:GOTO 12360
  241. 12380 N=1:N$="":M=18:GOSUB 680:RETURN 'convert PS(I) to P$
  242. 12390 '+++++     Get course rating     +++++
  243. 12400 KB$=INKEY$:IF KB$<>"" THEN 12400
  244. 12410 IF T1=1 THEN M1$="GOLD TEEs"
  245. 12420 IF T1=2 THEN M1$="BLUE TEEs"
  246. 12430 IF T1=3 THEN M1$="WHITE TEEs"
  247. 12440 IF T1=4 THEN M1$="RED TEEs"
  248. 12450 CLS:PRINT"ENTER the course rating, e.g. 71.0, for ";M1$;" at ";B2$:PRINT
  249. 12460 INPUT"If this rating is not applicable, just press the ENTER key. ",KB$
  250. 12470 IF MID$(KB$,3,1)="." AND LEN(KB$)=4 THEN 12510
  251. 12480 IF VAL(KB$)=0 THEN 12510
  252. 12490 PRINT:PRINT"Please check the course rating and re-enter."
  253. 12500 GOSUB 580:GOTO 12450
  254. 12510 T!=VAL(KB$):RETURN 'course rating
  255. 12520 '+++++      get HANDICAP #'s    +++++
  256. 12530 '+++++     front side     +++++
  257. 12540 CLS:PRINT"ENTER the "M1$;" handicap numbers for the FRONT side."
  258. 12550 PRINT:PRINT SPC(6);"Hole #  H'cap #"
  259. 12560 S=2:N=2:M=9:L=0:GOSUB 720 'get h'caps
  260. 12570 RESTORE 833:GOSUB 600:T$="Change a front nine handicap"
  261. 12580 IF KB$="Y" THEN T1$=M1$:M1$="H'cap":GOSUB 740:M1$=T1$:GOTO 12570
  262. 12590 '+++++     back side     +++++
  263. 12600 CLS:PRINT"ENTER the ";M1$;" handicap numbers for the BACK side."
  264. 12610 PRINT:PRINT SPC(6);"Hole #  H'cap #"
  265. 12620 S=2:N=2:M=9:L=9:GOSUB 720 'get h'caps
  266. 12630 RESTORE 833:GOSUB 600:T$="Change a back nine handicap"
  267. 12640 IF KB$="Y" THEN T1$=M1$:M1$="H'cap":GOSUB 740:M1$=T1$:GOTO 12630
  268. 12650 N=2:N$="":M=18:GOSUB 680:RETURN 'convert ps(i) to p$
  269. 14000 '+++++     grunt work
  270. 14010 DELETE 490-9999
  271. 14020 SAVE"b:course.asc",A
  272. 14030 RUN"b:main.bas"
  273. 15000 'for chain delete
  274. 4000 '+++++     grunt work
  275. 14010 DELETE 490-9999
  276. 14020 SAVE"b:course.asc",A
  277. 14030 RUN"b:main.bas"
  278.